home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol093 / seidel.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  3.1 KB  |  80 lines
  1. 10 REM: FIND-A-WORD PUZZLE GENERATOR
  2. 20 REM: SUBMITTED BY MARK-DAVID SEIDEL
  3. 30 RANDOMIZE VAL(RIGHT$(TIME$,2))
  4. 40 SCREEN 0,0,0:COLOR 7,0,0:WIDTH 40:CLS:KEY OFF
  5. 50 LOCATE 8,14:PRINT "If you would like to see the puzzle on"
  6. 60 LOCATE 10,14:PRINT "the screen as you make it type 0 ;"
  7. 70 LOCATE 12,14:PRINT "for a blank screen type 1:  ";
  8. 80 INPUT BLANK:CLS
  9. 85 LOCATE 2,14:PRINT "To creat a puzzle, enter a word you"
  10. 90 PRINT "would like to have in the puzzle   "
  11. 95 PRINT "after 'WORD #  0   ?'"
  12. 100 LOCATE 10,14:PRINT "When you have entered all the words you"
  13. 105 PRINT "would like in the puzzle, type the word"
  14. 110 PRINT "'STOP'and the computer will do the rest."
  15. 115 LOCATE 20,10:PRINT "Press any key to continue       ":A$=INKEY$:IF A$ = "" THEN 115
  16. 120 DIM W$(200),B%(3,3),A%(40,20):Z = 0:CLS
  17. 130  Z = Z+1
  18. 140 LOCATE 22,1:PRINT "Word # ";Z;":    ";:INPUT A$: IF A$ = ""     THEN 140
  19. 141 FOR I=1 TO LEN(A$)
  20. 142 MID$(A$,I,1)=CHR$(95 AND (ASC(MID$(A$,I,1))))
  21. 143 NEXT I
  22. 150 IF A$ = "STOP"  THEN 490
  23. 160 W$(Z) = A$
  24. 170 U = INT(RND(1)*20)+1:L = INT(RND(1)*40)+1
  25. 180 FOR X = -1 TO 1 : FOR Y = -1 TO 1
  26. 190 IF  X = Y AND Y = 0 THEN 290
  27. 200 X1 = L: Y1 = U
  28. 210    FOR C = 1 TO LEN(A$)
  29. 220      X1 = X1 + X: Y1 = Y1 + Y
  30. 230      IF X1 > 40 OR X1 < 1 OR Y1 > 20 OR Y1 < 1 THEN             B%(X+2,Y+2)=0:GOTO 290
  31. 240      IF A%(X1,Y1) = 0 THEN 270
  32. 250      IF A%(X1,Y1) <> ASC(MID$(A$,C,1)) THEN             B%(X+2,Y+2)=0:GOTO 290
  33. 260      B%(X+2,Y+2) = B%(X+2,Y+2) +1
  34. 270    NEXT C
  35. 280  B%(X+2,Y+2) = B%(X+2,Y+2) +1: B = B + 1
  36. 290 NEXT Y: NEXT X
  37. 300 IF B = 0 THEN 170
  38. 310 R = 2:D = 2
  39. 320 FOR X = 1 TO 3: FOR Y = 1 TO 3
  40. 330    IF B%(X,Y) > B%(R,D) THEN R = X:D = Y
  41. 340 NEXT Y: NEXT X
  42. 350 X = R-2: Y = D-2
  43. 360 IF X = -1 AND Y = -1 AND B%(1,1) = 1 THEN 380
  44. 370 GOTO 400
  45. 380 X = INT(RND(1)*3)-1: Y = INT(RND(1)*3)-1
  46. 390 IF (X=0 AND Y=0) OR (B%(X+2,Y+2) = 0) THEN 380
  47. 400 X1 = L: Y1 = U
  48. 410 FOR C = 1 TO LEN(A$)
  49. 420    X1 = X1 + X: Y1 = Y1 + Y
  50. 430    A%(X1,Y1) = ASC(MID$(A$,C,1))
  51. 440    IF BLANK THEN 460
  52. 450     LOCATE Y1,X1:PRINT CHR$(A%(X1,Y1));
  53. 460 NEXT C
  54. 470 B=0: FOR X=1 TO 3: FOR Y=1 TO 3: B%(X,Y)=0:NEXT Y :NEXT X
  55. 480 LOCATE 22,1:PRINT SPC(39);:GOTO 130
  56. 490 FOR X = 1 TO 40: FOR Y = 1 TO 20
  57. 500    IF  A%(X,Y) <> 0 THEN 520
  58. 510    A%(X,Y) = 45: LOCATE Y,X: PRINT "-";
  59. 520 NEXT Y: NEXT X
  60. 530 LOCATE 22,1:INPUT "Ready to print: Turn on printer and      press <RETURN>...";A$: GOSUB 640
  61. 540 LPRINT :LPRINT "WORD PUZZLE ANSWER KEY"
  62. 550 LPRINT CHR$(12)
  63. 560 PRINT:PRINT "Please wait a minute for me to create a puzzle..."
  64. 570 FOR X = 1 TO 40: FOR Y = 1 TO 20
  65. 580    IF A%(X,Y) <> 45 THEN 600
  66. 590    B = INT(RND(1)*26)+65:A%(X,Y) = B
  67. 600 NEXT Y: NEXT X
  68. 610 GOSUB 640
  69. 620 LPRINT: LPRINT "Computer Generated word puzzle"
  70. 630 LPRINT CHR$(12):GOTO 690
  71. 640 LPRINT
  72. 650 FOR X=1 TO 40: FOR Y=1 TO 20: LPRINT CHR$(A%(X,Y));"  ";
  73. 670 NEXT Y: LPRINT :NEXT X
  74. 680 RETURN
  75. 690 LPRINT :LPRINT: LPRINT "Word List":LPRINT
  76. 700 FOR I = 1 TO Z-1: LPRINT W$(I): NEXT I
  77. 710 LPRINT CHR$(12)
  78. 720 PRINT: INPUT "Would you like another copy? (y/n)";A$:IF     LEFT$(A$,1)= "Y" OR A$= "y" THEN GOTO 610
  79. 730 END
  80.